Четкий и лаконичный способ применить стандартизацию как к обучающему, так и к тестовому набору в R

Я выбираю разделение 90/10 Training/Test с некоторыми данными в R. После того, как у меня есть набор Training. Я хотел бы стандартизировать его. Затем я хотел бы использовать то же среднее значение и стандартное отклонение, что и в тренировочном наборе, и применить эту стандартизацию к тестовому набору.

Я хотел бы сделать это максимально возможным способом base-R, но было бы хорошо и с решением dplyr. Обратите внимание, что у меня есть столбцы, которые имеют значения factors/chr и numeric. Конечно, мне нужно сначала выбрать числовые.

Моя первая установка приведена ниже с воспроизводимым примером кода. У меня есть средние значения и стандартные отклонения для соответствующих числовых столбцов, как теперь я могу применить стандартизацию обратно к конкретным столбцам данных обучения и тестирования?

library(tidyverse)
rm(list = ls())
x <- data.frame("hame" =  c("Bob", "Roberta", "Brady", "Jen", "Omar", "Phillip", "Natalie", "Aaron", "Annie", "Jeff"),
                "age" = c(60, 55, 25, 30, 35, 40, 47, 32, 34,67),
                "income" = c(50000, 60000, 100000, 90000, 100000, 95000, 75000, 85000, 95000, 105000))

train_split_pct = 0.90

train_size <- ceiling(nrow(x)*train_split_pct)  # num of rows for training set
test_size <- nrow(x) - train_size               # num of rows for testing set 

set.seed(123)
ix <-  sample(1:nrow(x)) # shuffle
x_new = x[ix, ]
Train_set  = x_new[1:train_size, ]
Test_set   = x_new[(train_size+1):(train_size+test_size), ]

Train_mask <- Train_set %>% select_if(is.numeric) 
Train_means <- Train_mask %>% apply(2, mean)
Train_stddevs <- Train_mask %>% apply(2, sd)

r dataframe training-data dplyr standardized
person Coldchain9    schedule 21.10.2020    source источник

Ответы (3)


arrow_upward
2
arrow_downward

Мы можем сделать это лаконично. Получите mean, sd из набора данных "Train" ("mean_sd"). Обратите внимание, что с версией dplyr ›= 1.0 summarise может возвращать более одной строки. Итак, используйте эту функцию для создания двухстрочного набора данных: первая строка => среднее значение, вторая строка => sd.

library(dplyr) # >= 1.0.0    
library(purrr)
mean_sd <- Train_set %>%
    summarise(across(where(is.numeric),  ~ c(mean(., na.rm = TRUE), 
            sd(., na.rm = TRUE))))

Затем создайте функцию («f1») для стандартизации.

f1 <- function(x, y) (x -y[1])/y[2]

Переберите list набора данных «Train», «Test», используйте map2, чтобы перебрать соответствующие столбцы на основе набора данных «mean_sd», примените f1 и назначьте этот вывод столбцам. Затем с помощью list2env мы можем обновить те же объекты в глобальной среде.

list2env(map(lst(Train_set, Test_set), ~  {
   .x[names(mean_sd)] <- map2(select(.x, names(mean_sd)), mean_sd, f1)
         .x}), .GlobalEnv)

-выход

Train_set
#   hame        age     income
#3    Brady -1.3286522  0.7745967
#10    Jeff  1.6256451  1.0327956
#2  Roberta  0.7815601 -1.2909944
#8    Aaron -0.8362693  0.0000000
#6  Phillip -0.2735460  0.5163978
#9    Annie -0.6955885  0.5163978
#1      Bob  1.1332622 -1.8073922
#7  Natalie  0.2188368 -0.5163978
#5     Omar -0.6252481  0.7745967


Test_set
# hame        age    income
#4  Jen -0.9769502 0.2581989
person akrun    schedule 21.10.2020
comment
Не могли бы вы обсудить ~ в summarise, пожалуйста? - person Coldchain9; 22.10.2020
comment
@Coldchain9 это просто лямбда-функция, т. е. сокращение function(x) в синтаксисе tidyverse. - person akrun; 22.10.2020

arrow_upward
1
arrow_downward

Рассмотрите это как вариант. Вы можете использовать функцию scale(), которая позволяет нормализовать ваши переменные. В конце вы можете найти код. Кроме того, вы можете использовать mutate_if() для выбора числовых переменных и избежать создания других фреймов данных. Вот код, использующий dplyr, где я создал два новых фрейма данных с требуемыми значениями:

library(tidyverse)
rm(list = ls())
x <- data.frame("hame" =  c("Bob", "Roberta", "Brady", "Jen", "Omar", "Phillip", "Natalie", "Aaron", "Annie", "Jeff"),
                "age" = c(60, 55, 25, 30, 35, 40, 47, 32, 34,67),
                "income" = c(50000, 60000, 100000, 90000, 100000, 95000, 75000, 85000, 95000, 105000))

train_split_pct = 0.90

train.size <- ceiling(nrow(x)*train_split_pct)  # num of rows for training set
test.size <- nrow(x) - train.size               # num of rows for testing set 

set.seed(123)
ix <-  sample(1:nrow(x)) # shuffle
x_new = x[ix, ]
Train.set  = x_new[1:train.size, ]
Test.set   = x_new[(train.size+1):(train.size+test.size), ]
#Normalize
Train.set2 <- Train.set %>%
  mutate_if(is.numeric, scale)
Test.set2 <- Test.set %>%
  mutate_if(is.numeric, scale)

Обновление: если scale() не работает, вы можете попробовать изменить форму данных и объединить их с вычисленными значениями для среднего и стандартного отклонения:

#Define indexes for numeric vars
index.train <- which(names(Train.set)%in% names(Train_means))
#Format means and sd to merge
Train2 <- Train.set %>% 
  mutate(id=row_number()) %>%
  pivot_longer(cols=index.train) %>%
  left_join(
    Train_means %>% t() %>%data.frame %>%
      pivot_longer(everything()) %>%
      rename(Mean=value) %>%
      left_join(Train_stddevs %>% t() %>%data.frame %>%
                  pivot_longer(everything()) %>%
                  rename(SD=value))
  ) %>%
  #Compute standard values
  mutate(SValue=(value-Mean)/SD) %>%
  select(-c(value,Mean,SD)) %>%
  pivot_wider(names_from = name,values_from=SValue) %>% select(-id)

Выход:

# A tibble: 9 x 3
  hame       age income
  <fct>    <dbl>  <dbl>
1 Brady   -1.33   0.775
2 Jeff     1.63   1.03 
3 Roberta  0.782 -1.29 
4 Aaron   -0.836  0    
5 Phillip -0.274  0.516
6 Annie   -0.696  0.516
7 Bob      1.13  -1.81 
8 Natalie  0.219 -0.516
9 Omar    -0.625  0.775

И для тестового набора процесс аналогичен:

#Define indexes
index.test <- which(names(Test.set)%in% names(Train_means))
#Format means and sd 2
Test2 <- Test.set %>% 
  mutate(id=row_number()) %>%
  pivot_longer(cols=index.test) %>%
  left_join(
    Train_means %>% t() %>%data.frame %>%
      pivot_longer(everything()) %>%
      rename(Mean=value) %>%
      left_join(Train_stddevs %>% t() %>%data.frame %>%
                  pivot_longer(everything()) %>%
                  rename(SD=value))
  ) %>%
  #Compute standard values
  mutate(SValue=(value-Mean)/SD) %>%
  select(-c(value,Mean,SD)) %>%
  pivot_wider(names_from = name,values_from=SValue) %>% select(-id)

Выход:

# A tibble: 1 x 3
  hame     age income
  <fct>  <dbl>  <dbl>
1 Jen   -0.977  0.258

Ключ объединяет значения после изменения формы. В качестве доказательства я покажу промежуточный шаг для окончательного набора данных. Это выглядит так:

# A tibble: 2 x 7
  hame     id name   value    Mean      SD SValue
  <fct> <int> <chr>  <dbl>   <dbl>   <dbl>  <dbl>
1 Jen       1 age       30    43.9    14.2 -0.977
2 Jen       1 income 90000 85000   19365.   0.258

Таким образом легко вычислить стандартные значения, которые вы хотите.

person Duck    schedule 21.10.2020
comment
Я пробовал этот метод ранее, но он не достигает моей желаемой цели. Я хочу применить ту же статистику выборки mean/sd, которую я получаю при масштабировании Training set, и применить ее к Testing set. Например. мой возраст mean составляет 43,89 года для Train_set, а возраст sd составляет 14,22 года для Train_set. Я хочу использовать их для стандартизации возраста Test_set и так далее. - person Coldchain9; 22.10.2020
comment
@Coldchain9 Есть способ, но длиннее, позвольте мне добавить! - person Duck; 22.10.2020
comment
@Coldchain9 Я добавил для вас обновление. Я надеюсь, что это может быть полезно и полезно для вас! - person Duck; 22.10.2020
comment
Я вижу, что это работает, но это довольно сложно и не просто. - person Coldchain9; 22.10.2020

arrow_upward
0
arrow_downward

Поэтому, просмотрев предыдущие ответы, которые работали нормально, я обнаружил, что они немного непонятны в использовании и не интуитивно понятны. Я добился желаемого результата с помощью цикла for. Хотя это немного рудиментарно, я считаю, что это более четкий подход. Учитывая вариант использования, когда у меня не так много столбцов, я не вижу серьезной проблемы в этом решении, если только не было много столбцов данных для обработки. В этом случае мне понадобится помощь в поиске более быстрого решения.

Тем не менее, мой метод заключается в следующем. Я собираю все имена столбцов в свой Train_mask, который представляет собой только числовые столбцы. Затем я перебираю каждое из имен и обновляю значения в соответствии со стандартизацией их соответствующих Train_means и Train_stddevs.

Из-за того, как я строю свои наборы для обучения и тестирования, не должно быть проблем с порядком кадров моих столбцов, и их можно использовать последовательно следующим образом.

library(tidyverse)
rm(list = ls())
x <- data.frame("name" =  c("Bob", "Roberta", "Brady", "Jen", "Omar", "Phillip", "Natalie", "Aaron", "Annie", "Jeff"),
                "age" = c(60, 55, 25, 30, 35, 40, 47, 32, 34,67),
                "income" = c(50000, 60000, 100000, 90000, 100000, 95000, 75000, 85000, 95000, 105000))

train_split_pct = 0.90

train_size <- ceiling(nrow(x)*train_split_pct)  # num of rows for training set
test_size <- nrow(x) - train_size               # num of rows for testing set 

set.seed(123)
ix <-  sample(1:nrow(x)) # shuffle
x_new = x[ix, ]
Train_set  = x_new[1:train_size, ]
Test_set   = x_new[(train_size+1):(train_size+test_size), ]

Train_mask <- Train_set %>% select_if(is.numeric) 
Train_means <- data.frame(as.list(Train_mask %>% apply(2, mean)))
Train_stddevs <- data.frame(as.list(Train_mask %>% apply(2, sd)))


col_names <- names(Train_mask)
for (i in 1:ncol(Train_mask)){
  Train_set[,col_names[i]] <- (Train_set[,col_names[i]] - Train_means[,col_names[i]])/Train_stddevs[,col_names[i]]
  Test_set[,col_names[i]] <-  (Test_set[,col_names[i]] - Train_means[,col_names[i]])/Train_stddevs[,col_names[i]]
}

Train_set
Test_set

Выход:

> Train_set
      name       age     income
3    Brady -3.180620  0.7745967
10    Jeff -2.972814  1.0327956
2  Roberta -3.032187 -1.2909944
8    Aaron -3.145986  0.0000000
6  Phillip -3.106404  0.5163978
9    Annie -3.136090  0.5163978
1      Bob -3.007448 -1.8073922
7  Natalie -3.071769 -0.5163978
5     Omar -3.131143  0.7745967
> Test_set
  name        age    income
4  Jen -0.9769502 0.2581989
person Coldchain9    schedule 22.10.2020