Взять среднее из цифр, которые запускаются вместе в одном столбце - PullRequest
Новая
       14

Взять среднее из цифр, которые запускаются вместе в одном столбце

4 голосов
/ 11 июня 2019

Мои данные в этом формате: 

country gdp digits
US      100 2657
Aus     50  123
NZ      40  11

, и я хотел бы взять среднее значение для каждой страны отдельных цифр, которые все хранятся в столбце digits.

Итак, вот к чему я стремлюсь: 

country gdp digits mean_digits
US      100 2657   5
Aus     50  123    2
NZ      40  11     1

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

Код для воспроизводимых данных ниже: 

df <- data.frame(stringsAsFactors=FALSE,
     country = c("US", "AUS", "NZ"),
         gdp = c(100, 50, 40),
      digits = c(2657, 123, 11)
)

Ответы [ 6 ]

4 голосов
/ 11 июня 2019

Нам нужна функция, чтобы разбить число на цифры и взять среднее значение: 

mean_digits = function(x) {
  sapply(strsplit(as.character(x), split = "", fixed = TRUE),
         function(x) mean(as.integer(x)))
}

df$mean_digits = mean_digits(df$digits)
df
#   country gdp digits mean_digits
# 1      US 100   2657           5
# 2     AUS  50    123           2
# 3      NZ  40     11           1

as.character() преобразует числовой ввод в character, strsplit разбивает числа на отдельные цифры (в результате list), затем с sapply, для каждого элемента списка, который мы конвертируем в целое число, и принимаем имею в виду.

Мы используем fixed = TRUE для небольшой эффективности, так как нам не нужно никакого специального регулярного выражения для разделения каждой цифры на части.

Если вы часто используете эту функцию, вы можете round или проверить, что ввод является целым числом, он вернет NA, если вход имеет десятичные числа из-за ..

3 голосов
/ 11 июня 2019

1) strapply Этот однострочник использует strapply в gsubfn. Он преобразует каждую цифру в числовое значение, а затем принимает среднее значение для каждого. 

library(gsubfn)

transform(df, mean = sapply(strapply(digits, ".", as.numeric, simplify = TRUE), mean))

2) Это немного длиннее, но все же одно утверждение и не использует пакетов. Он вставляет пробел между цифрами, читает их, используя read.table, а затем применяет rowMeans. 

transform(df, 
  mean = rowMeans(read.table(text = gsub("\\b", " ", digits), fill = NA), na.rm = TRUE))
2 голосов
/ 11 июня 2019

Это может быть более эффективно сделано с помощью арифметики.

Вдохновленные этим решением мы могли бы сделать: 

mnDigit <- function(x) {
  n <- nchar(x)
  sq <- as.numeric(paste0("1e", n:0))
  mean((x %% sq[-length(sq)]) %/% sq[-1])
}

sapply(df$digits, mnDigit)
# [1] 5 2 1

Объяснение: Вфункция nchar сначала считает цифры и создает вектор степеней 10.Последняя строка в основном подсчитывает каждую степень 10 по модулю.

Применение "более общего решения", упомянутого в связанном ответе, выглядело бы так (спасибо @ thothal для исправленияошибка): 

mnDigit2 <- function(a) {
  dig <- ceiling(log10(a + 1))
  vec1 <- 10^(dig:1)
  vec2 <- vec1 / 10
  mean((a %% vec1) %/% vec2)
}

Давайте посмотрим на тест: 

  Unit: milliseconds
            expr        min         lq      mean    median         uq         max neval cld
mnDigit2          140.65468  152.48952  173.7740  171.3010  179.23491   248.25977    10  a 
mnDigit           130.21340  151.76850  185.0632  166.7446  193.03661   292.59642    10  a 
stringr           112.80276  116.17671  129.7033  130.6521  137.24450   149.82282    10  a 
strsplit          106.64857  133.76875  155.3771  138.6853  148.58234   257.20670    10  a 
rowMeans           27.58122   28.55431   37.8117   29.5755   41.82507    66.96972    10  a 
strapply         6260.85467 6725.88120 7673.3511 6888.5765 8957.92438 10773.54486    10   b
split_based       363.59171  432.15120  475.5603  459.9434  528.20592   623.79144    10  a 
arithmetic_based  137.60552  172.90697  195.4316  183.1395  208.44365   292.07671    10  a

Примечание: Я вынул tidyverse решенияпотому что они слишком вложены в дополнительные манипуляции с фреймами данных.

Однако, похоже, НЕ , чтобы быть правдой.На самом деле подход rowMeans - read.table кажется самым быстрым.

Данные 

df <- structure(list(country = c("US", "AUS", "NZ"), gdp = c(100, 50, 
40), digits = c(2657, 123, 11)), class = "data.frame", row.names = c(NA, 
-3L))

Код эталона 

set.seed(42)
evav <- sample(1:1e5, size=1e4)

library(stringr)  # for str_extract_all
library(gsubfn)  # for strapply
microbenchmark::microbenchmark(mnDigit2=sapply(evav, mnDigit2),
                               mnDigit=sapply(evav, mnDigit2),
                               stringr=sapply(str_extract_all(evav, ".{1}"), function(x) mean(as.numeric(x))),
                               strsplit=mean_digits(evav),
                               rowMeans=rowMeans(read.table(text = gsub("\\b", " ", evav), fill = NA), na.rm = TRUE),
                               strapply=sapply(strapply(evav, ".", as.numeric, simplify=TRUE), mean),
                               split_based=sapply(evav, split_based),
                               arithmetic_based=sapply(evav, arithmetic_based),
                               times=10L,
                               control=list(warmup=10L))
# see `mean_digits` `split_based` & `arithmetic_based` functions in other answers
2 голосов
/ 11 июня 2019

Другой tidyverse однострочный без других зависимостей: 

df %>% mutate(mean_digits =  map_dbl(strsplit(as.character(df$digits), ""), 
                                     ~ mean(as.numeric(.x))))
#   country gdp digits mean_digits
# 1      US 100   2657           5
# 2     AUS  50    123           2
# 3      NZ  40     11           1

Объяснение

  1. Вы используете strsplit, чтобы разбить цифры на отдельные цифры. Это дает вам список, где каждый элемент содержит одну цифру.
  2. Затем вы перебираете этот список и вычисляете mean по этим цифрам. Здесь мы используем map_dbl из purrr, но простой sapply также поможет.

Или решение, основанное на арифметике, а не на разбиении строк: 

df %>% mutate(mean_digits = 
                map_dbl(digits, 
                        ~ mean((.x %/% 10 ^ (0:(nchar(as.character(.x)) - 1)) %% 10))))

Объяснение

Вы делите целое число (%/%) каждого числа на степени 10 (то есть 10^0, 10^1, 10^2, ..., 10^i до количества цифр, и вы берете этот результат по модулю 10 (который дает вам точно исходную цифру). Затем вы вычисляете среднее значение.

Голые функции для бенчмаркинга 

split_based <- function(x) {
   sapply(strsplit(as.character(x), ""), 
            function(.x) mean(as.numeric(.x)))
}

## split_based(df$digits)

arithmetic_based <- function(.x) {
   mean((.x %/% 10 ^ (0:(nchar(as.character(.x)) - 1)) %% 10))
}

## sapply(df$digits, arithmetic_based)
2 голосов
/ 11 июня 2019

Вот альтернатива stringr. Он использует sapply с str_extract_all для извлечения символов df$digits для каждой строки и вычисляет среднее значение. 

library(stringr)
df$mean_digits <- sapply(str_extract_all(df$digits, ".{1}"), function(x) mean(as.numeric(x)))

df
  country gdp digits mean_digits
1      US 100   2657           5
2     AUS  50    123           2
3      NZ  40     11           1

Или, если вы действительно хотите, вы можете сделать это, используя матричный вывод из str_extract_all и rowMeans. Примечание: для str_extract_all, simplify = FALSE является значением по умолчанию. 

extracted_mat <- str_extract_all(df$digits, ".{1}", simplify = TRUE)
class(extracted_mat) <- "numeric"

df$mean_digits <- rowMeans(extracted_mat, na.rm = T)

РЕДАКТИРОВАТЬ: запуск эталонных тестов в большем масштабе (т. Е. Используя примерное предложение @ Gregor). 

# Packages 
library(stringr)
library(gsubfn)

# Functions
mean_digits = function(x) {
  sapply(strsplit(as.character(x), split = "", fixed = TRUE),
         function(x) mean(as.integer(x)))
}
mnDigit <- function(x) {
  n <- nchar(x)
  sq <- as.numeric(paste0("1e", n:0))
  mean((x %% sq[-length(sq)]) %/% sq[-1])
}
mnDigit2 <- function(a) {
  dig <- ceiling(log10(a + 1))
  vec1 <- 10^(dig:1)
  vec2 <- vec1 / 10
  mean((a %% vec1) %/% vec2)
}

# Creating x
set.seed(1)
x = sample(1:1e7, size = 5e5)


microbenchmark::microbenchmark(mnDigit2=sapply(x, mnDigit2),
                               mnDigit=sapply(x, mnDigit),
                               stringr=sapply(str_extract_all(x, ".{1}"), function(x) mean(as.numeric(x))),
                               stringr_matrix = {
                                 extracted_mat <- str_extract_all(x, ".{1}", simplify = TRUE)
                                 class(extracted_mat) <- "numeric"
                                 rowMeans(extracted_mat, na.rm = T)
                               },
                               strsplit=mean_digits(x),
                               rowMeans=rowMeans(read.table(text = gsub("\\b", " ", x), fill = NA), na.rm = TRUE),
                               #strapply=sapply(strapply(x, ".", as.numeric, simplify=TRUE), mean),
                               times = 10)
Unit: milliseconds
           expr       min       lq     mean   median       uq      max neval  cld
       mnDigit2 3154.4249 3226.633 3461.847 3445.867 3612.690 3840.691    10   c 
        mnDigit 6403.7460 6613.345 6876.223 6736.304 6965.453 7634.197    10    d
        stringr 3277.0188 3628.581 3765.786 3711.022 3808.547 4347.229    10   c 
 stringr_matrix  944.5599 1029.527 1136.334 1090.186 1169.633 1540.976    10 a   
       strsplit 3087.6628 3259.925 3500.780 3416.607 3585.573 4249.027    10   c 
       rowMeans 1354.5196 1449.871 1604.305 1594.297 1745.088 1828.070    10  b 



identical(sapply(x, mnDigit2), sapply(x, mnDigit))
[1] TRUE
identical(sapply(x, mnDigit2), sapply(str_extract_all(x, ".{1}"), function(x) mean(as.numeric(x))))
[1] TRUE
identical(sapply(x, mnDigit2), {
  extracted_mat <- str_extract_all(x, ".{1}", simplify = TRUE)
  class(extracted_mat) <- "numeric"
  rowMeans(extracted_mat, na.rm = T)
})
[1] TRUE
identical(sapply(x, mnDigit2), mean_digits(x))
[1] TRUE
identical(sapply(x, mnDigit2), rowMeans(read.table(text = gsub("\\b", " ", x), fill = NA), na.rm = TRUE))
[1] TRUE
2 голосов
/ 11 июня 2019

Одна tidyverse возможность может быть: 

df %>%
 mutate(digits = str_split(digits, pattern = "")) %>%
 unnest() %>%
 group_by(country, gdp) %>%
 summarise(digits = mean(as.numeric(digits)))

  country   gdp digits
  <chr>   <int>  <dbl>
1 Aus        50      2
2 NZ         40      1
3 US        100      5

Или: 

df %>%
 mutate(digits = str_split(digits, pattern = "")) %>%
 unnest() %>%
 group_by(country, gdp) %>%
 summarise_all(list(~ mean(as.numeric(.))))
...